home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tvdmx.exe / DLGSHOP.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-16  |  9KB  |  309 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    DLGSHOP --tvDMX dialog demo program        }
  5. {    tvDMX    --data editing project (ver 1.5)    }
  6. {                            }
  7. {    Copyright (c) 1992  Randolph Beck        }
  8. {                P.O. Box  56-0487        }
  9. {                Orlando, FL 32856        }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program DLGSHOP;
  15.  
  16. {  This program demonstrates the use of tvDMX objects in dialog windows.
  17.    There are two examples:  EditRecord and EditInvoice.
  18.  
  19.    EditRecord presents a standard dialog box similar to the one created
  20.    in the program SAMPLES.PAS.  It uses the InsertField() function from
  21.    unit StdDMX.PAS to position each field in the record.
  22.  
  23.    DeskTop^.GetExtent (R) initializes the window's rectangle as oversized,
  24.    and the size is trimmed down and centered by the TrimDialog() procedure
  25.    after all the component views are inserted.
  26.  
  27.    EditInvoice inserts several fields using InsertField(), but the largest
  28.    section of the window is taken by a TDmxEditDlg view, which has many
  29.    records.  TDmxEditDlg views are tvDMX objects which have been modified
  30.    (via virtual methods) to operate within a dialog box.
  31.  
  32.    This program is not yet complete.  A future version may use methods
  33.    similar to those in object TDmxPayroll (in program SAMPLES.PAS) that
  34.    calculate several fields in the record.
  35.  }
  36.  
  37. {$M 16384,8192,655360 }
  38. {$V-,X+,D-,B-,R- }
  39.  
  40. uses
  41.     Dos,
  42.     Objects, Drivers, Views, Menus, Dialogs, App,
  43.     RSet, DmxGizma, tvDMX, StdDMX, tvGizma;
  44.  
  45.  
  46. const
  47.     cmEditRec     =  101;
  48.     cmInvoice     =  102;
  49.  
  50.     cmNoCmd       = 1000;
  51.  
  52.     hcMenus       = 1100;
  53.     hcDeskTop     = 1200;
  54.     hcDialogs     = 4000;
  55.  
  56.  
  57. type
  58.     TMyApp    =  OBJECT (TApplication)
  59.       constructor Init;
  60.       destructor  Done;  VIRTUAL;
  61.       procedure HandleEvent (var Event : TEvent);  VIRTUAL;
  62.       procedure InitMenuBar;  VIRTUAL;
  63.       procedure InitStatusLine;  VIRTUAL;
  64.       procedure EditRecord;   VIRTUAL;
  65.       procedure EditInvoice;  VIRTUAL;
  66.     end;
  67.  
  68.  
  69.   { ══ TMyApp ════════════════════════════════════════════════════════════ }
  70.  
  71.  
  72. constructor TMyApp.Init;
  73. begin
  74.   TApplication.Init;
  75.   DeskTop^.HelpCtx := hcDeskTop;
  76. end;
  77.  
  78.  
  79. destructor TMyApp.Done;
  80. begin
  81.   TApplication.Done;
  82.   PrintStr (#27'[J'^M'   '^M);  { clear screen with ANSI colors }
  83. end;
  84.  
  85.  
  86. procedure TMyApp.HandleEvent (var Event : TEvent);
  87. begin
  88.   TApplication.HandleEvent (Event);
  89.   If Event.What = evCommand then
  90.     begin
  91.     Case Event.Command of
  92.       cmEditRec:  EditRecord;
  93.       cmInvoice:  EditInvoice;
  94.      else      Exit;
  95.       end;
  96.     ClearEvent (Event);
  97.     end;
  98. end;
  99.  
  100.  
  101. procedure TMyApp.InitMenuBar;
  102. var  R: TRect;
  103. begin
  104.   GetExtent (R);
  105.   R.B.Y := R.A.Y + 1;
  106.   MenuBar := New (PMenuBar, Init (R, NewMenu (
  107.     NewSubMenu ('~D~ialogShop', hcMenus, NewMenu (
  108.       NewItem ('~N~ew Record', '',   kbNoKey, cmEditRec, hcNoContext,
  109.       NewItem ('~I~nvoice',    '',   kbNoKey, cmInvoice, hcNoContext,
  110.       NewLine (
  111.       NewItem ('e~X~it',  'Alt-X',   kbAltX,  cmQuit,  hcNoContext,
  112.       nil))))),
  113.     nil))
  114.   ));
  115.   MenuBar^.HelpCtx := hcMenus;
  116. end;
  117.  
  118.  
  119. procedure TMyApp.InitStatusLine;
  120. var  R: TRect;
  121. begin
  122.   GetExtent (R);
  123.   R.A.Y := R.B.Y - 1;
  124.   StatusLine := New (PStatusLine, Init (R,
  125.     NewStatusDef (hcNoContext, hcDeskTop - 1,
  126.       NewStatusKey ('~Dialog~Shop',     kbNoKey, cmNoCmd,
  127.       nil),
  128.     NewStatusDef (hcDeskTop, hcDialogs - 1,
  129.       NewStatusKey ('~F10~ Menu',       kbF10,   cmMenu,
  130.       nil),
  131.     NewStatusDef (hcDialogs, $FFFF,
  132.       NewStatusKey ('~Esc~ Cancel',     kbEsc,   cmCancel,
  133.       NewStatusKey ('~Tab~ Next field', kbNoKey, cmNoCmd,
  134.       NewStatusKey ('~Shift-Tab~ Previous', kbNoKey, cmNoCmd,
  135.       nil))),
  136.     nil)))
  137.   ));
  138. end;
  139.  
  140.  
  141. procedure TMyApp.EditRecord;
  142. var  R       : TRect;
  143.      Dialog  : PCursorDlg;  { TDialog descendant }
  144.      B       : PButton;
  145.      P       : PView;
  146.      Control : word;
  147.      void    : word;
  148.      Date    : DateTime;
  149. begin
  150.   With Date do
  151.     begin
  152.     GetDate (Year, Month, Day, void);
  153.     GetTime (Hour, Min,   Sec, void);
  154.     end;
  155.   DeskTop^.GetExtent (R);
  156.   Dialog := New (PCursorDlg, Init (R, 'Data Record'));
  157.   With Dialog^ do
  158.     begin
  159.     HelpCtx  := hcDialogs;
  160.  
  161.     InsertField (Dialog, 5, 2, FALSE, '~N~ame:   ', ' SSSSSSSSSSSSSSSSSSSS');
  162.     InsertField (Dialog, 5, 4, FALSE, '~A~ddress:', ' SSSSSSSSSSSSSSSSSSSS');
  163.     InsertField (Dialog, 5, 6, FALSE, '~C~ity:   ', ' SSSSSSSSSSSSSSSSSSSS');
  164.     InsertField (Dialog, 5, 8, FALSE, '~S~tate:  ', ' SS');
  165.     InsertField (Dialog, 5,10, FALSE, '~Z~ip:    ', ' #####');
  166.     InsertField (Dialog, 9,12, TRUE,  '  ~D~ate     Time', fldDATETIME)^.SetData (Date);
  167.     InsertField (Dialog,11,15, FALSE, '~D~eposit:', '($rrr,rrr.rr)');
  168.     InsertField (Dialog,11,16, FALSE, '~B~alance:', '($rrr,rrr.rr)');
  169.  
  170.     R.Assign (0, 18, 10, 20);
  171.     B := New (PButton, Init (R, 'O~K~', cmOK, bfDefault));
  172.     B^.Options := B^.Options or ofCenterX;
  173.     Insert (B);
  174.  
  175.     SelectNext (FALSE);
  176.     end;
  177.  
  178.   TrimDialog (Dialog);
  179.   Control := DeskTop^.ExecView (Dialog);
  180.  
  181.   Dispose (Dialog, Done);
  182. end;
  183.  
  184.  
  185. procedure TMyApp.EditInvoice;
  186. const  DlgLabel = ' Item        Qty   Item Name                          Price        Total';
  187.        DlgInfo  = ' SSSSSSSSSS\WWWW \ ssssssssssssssssssssssssssssssss\rr,rrr.rr \($rrr,rrr.rr)';
  188.        DLabel   : string [length (DlgLabel)] = DlgLabel;
  189. var  R       : TRect;
  190.      P       : PView;
  191.      Dialog  : PCursorDlg;  { TDialog descendant }
  192.      B       : PButton;
  193.      DMX     : PDmxEditDlg;
  194.      Control : word;
  195.      void    : word;
  196.      Date    : DateTime;
  197.      DlgData : array [0..2047] of byte;
  198.  
  199.     function  InsertRadioButtons : PView;
  200.     var  R   : TRect;
  201.      P   : PView;
  202.     begin
  203.       R.Assign (52, 3, 75, 7);
  204.       P := New (PRadioButtons, Init (R,
  205.            NewSItem ('Cash',
  206.            NewSItem ('Check/MO',
  207.            NewSItem ('Bank Card',
  208.            NewSItem ('Store Card',
  209.            nil))))
  210.          ));
  211.       P^.HelpCtx := hcDialogs;
  212.       Dialog^.Insert (P);
  213.       InsertRadioButtons := P;
  214.     end;
  215.  
  216.     function  InsertDmxLabels : PDmxLink;
  217.     var R   : TRect;
  218.     Lbl : PDmxLink;
  219.     begin
  220.       R.Assign (2,10, 78,11);
  221.       Lbl := New (PDmxLabels, Init (@DLabel, R));
  222.       Dialog^.Insert (Lbl);
  223.       InsertDmxLabels := Lbl;
  224.     end;
  225.  
  226.     function  InsertRecInd : PDmxLink;
  227.     var R   : TRect;
  228.     Ind : PDmxLink;
  229.     begin
  230.       R.Assign (1, pred (Dialog^.Size.Y), 8, Dialog^.Size.Y);
  231.       Ind := New (PDmxRecInd, Init (R, 7));
  232.       Dialog^.Insert (Ind);
  233.       InsertRecInd := Ind;
  234.     end;
  235.  
  236. begin
  237.   With Date do GetDate (Year, Month, Day, void);
  238.   fillchar (DlgData, sizeof (DlgData), 0);
  239.  
  240.   DeskTop^.GetExtent (R);
  241.   Dialog := New (PCursorDlg, Init (R, 'Invoice Dialog'));
  242.   With Dialog^ do
  243.     begin
  244.     Options  := Options or ofCentered;
  245.     HelpCtx  := hcDialogs;
  246.  
  247.     InsertField (Dialog, 5, 2, FALSE, '~N~ame:   ', ' SSSSSSSSSSSSSSSSSSSSSS');
  248.     InsertField (Dialog, 5, 3, FALSE, '~A~ddress:', ' SSSSSSSSSSSSSSSSSSSSSS');
  249.     InsertField (Dialog, 5, 4, FALSE, '~C~ity:   ', ' SSSSSSSSSSSSSSSSSSSSSS');
  250.     InsertField (Dialog, 5, 5, FALSE, '~S~tate:  ', ' SS');
  251.     InsertField (Dialog, 5, 6, FALSE, '~Z~ip:    ', ' #####\####');
  252.     InsertField (Dialog, 5, 7, FALSE, '~P~hone:  ', '~(~###~)~ ###-####');
  253.     InsertField (Dialog, 5, 8, FALSE, '~D~ate:   ', fldDATE)^.SetData (Date);
  254.  
  255.     R.Assign (50, 2, 75, 3);
  256.     Insert (New (PLabel, Init (R, '~M~ethod of Payment', InsertRadioButtons)));
  257.  
  258.     InsertField (Dialog, 50, 7, TRUE, 'Card Number', '####-####-####-####');
  259.  
  260.  
  261.    { assign the tvDMX view }
  262.  
  263.     R.Assign (2,11, 78, Size.Y - 4);
  264.     DMX := New (PDmxEditDlg,
  265.         Init (DlgInfo,
  266.               DlgData,
  267.               sizeof (DlgData),
  268.               R,
  269.               InsertDmxLabels, InsertRecInd,  { local functions }
  270.               nil, { can be replaced with a horizontal scrollbar }
  271.               StandardScrollBar (sbVertical + sbHandleKeyboard)
  272.             ));
  273.     Insert (DMX);
  274.    { move vert. scrollbar to fit beside the tvDMX view }
  275.     R.Assign (78,11,